home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE20 / CLINIC / QTTEST2U.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-10-07  |  4.2 KB  |  147 lines
  1. unit QTTest2U;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     BtnFuncPointerParam: TButton;
  12.     BtnPascalFuncParams: TButton;
  13.     BtnCFuncParams: TButton;
  14.     BtnGenericApproach: TButton;
  15.     BtnProcNoParams: TButton;
  16.     BtnPascalProcParams: TButton;
  17.     BtnCProcParams: TButton;
  18.     BtnProcPointerParam: TButton;
  19.     BtnConstVarParams: TButton;
  20.     BtnOpenArrayParam: TButton;
  21.     procedure BtnProcNoParamsClick(Sender: TObject);
  22.     procedure BtnPascalProcParamsClick(Sender: TObject);
  23.     procedure BtnCProcParamsClick(Sender: TObject);
  24.     procedure BtnProcPointerParamClick(Sender: TObject);
  25.     procedure BtnConstVarParamsClick(Sender: TObject);
  26.     procedure BtnOpenArrayParamClick(Sender: TObject);
  27.     procedure BtnPascalFuncParamsClick(Sender: TObject);
  28.     procedure BtnCFuncParamsClick(Sender: TObject);
  29.     procedure BtnFuncPointerParamClick(Sender: TObject);
  30.     procedure BtnGenericApproachClick(Sender: TObject);
  31.   end;
  32.  
  33. var
  34.   Form1: TForm1;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. uses
  41.   QTThunkU;
  42.  
  43. var
  44.   DLLHandle: THandle16;
  45.  
  46. procedure TForm1.BtnProcNoParamsClick(Sender: TObject);
  47. begin
  48.   Call16BitRoutine('NoParameters', DllHandle, ccPascal, [0], [0]);
  49. end;
  50.  
  51. procedure TForm1.BtnPascalProcParamsClick(Sender: TObject);
  52. begin
  53.   Call16BitRoutine('Proc2ParamsPascal', DllHandle, ccPascal,
  54.     [5, 20], [SizeOf(Longint), SizeOf(Longint)]);
  55. end;
  56.  
  57. procedure TForm1.BtnCProcParamsClick(Sender: TObject);
  58. begin
  59.   Call16BitRoutine('Proc2ParamsC', DllHandle, ccCdecl,
  60.     [5, 20], [SizeOf(Longint), SizeOf(Longint)]);
  61. end;
  62.  
  63. procedure TForm1.BtnProcPointerParamClick(Sender: TObject);
  64. const
  65.   Msg: PChar = '32-bit call';
  66. begin
  67.   Call16BitRoutine('ProcPointerParam', DllHandle, ccPascal,
  68.     [Msg], [Succ(StrLen(Msg))]);
  69. end;
  70.  
  71. procedure TForm1.BtnConstVarParamsClick(Sender: TObject);
  72. var
  73.   Number: Smallint;
  74. const
  75.   Str: ShortString = 'Hello from 32-bit';
  76. begin
  77.   Number := 0;
  78.   Call16BitRoutine('ProcVarConstParams', DllHandle, ccPascal,
  79.     [@Number, @Str], [SizeOf(Smallint), Succ(Length(Str))]);
  80.   ShowMessage(Format('New value of var parameter is %d', [Number]));
  81. end;
  82.  
  83. procedure TForm1.BtnOpenArrayParamClick(Sender: TObject);
  84. type
  85.   TNumbers = array[11..15] of Smallint;
  86. const
  87.   Numbers: TNumbers = (1, 2, 3, 4, 5);
  88. begin
  89.   Call16BitRoutine('ProcOpenArrayParam', DllHandle, ccPascal,
  90.     [@Numbers, High(TNumbers) - Low(TNumbers)],
  91.     [SizeOf(TNumbers), SizeOf(Word)]);
  92. end;
  93.  
  94. procedure TForm1.BtnPascalFuncParamsClick(Sender: TObject);
  95. begin
  96.   ShowMessage(Format('Sum of parameters = %d',
  97.     [Call16BitRoutine('Func2ParamsPascal', DllHandle,
  98.     ccPascal, [5, 20], [SizeOf(Longint), SizeOf(Longint)])]));
  99. end;
  100.  
  101. procedure TForm1.BtnCFuncParamsClick(Sender: TObject);
  102. begin
  103.   ShowMessage(Format('Sum of parameters = %d',
  104.     [Call16BitRoutine('Func2ParamsC', DllHandle,
  105.     ccCdecl, [5, 20], [SizeOf(Longint), SizeOf(Longint)])]));
  106. end;
  107.  
  108. procedure TForm1.BtnFuncPointerParamClick(Sender: TObject);
  109. var
  110.   ReturnedMsg: PChar;
  111. const
  112.   Msg: PChar = '32-bit call';
  113. begin
  114.   ReturnedMsg := PChar(Call16BitRoutine('FuncPointerParam',
  115.     DllHandle, ccPascal, [Msg], [Succ(StrLen(Msg))]));
  116.   ShowMessage(Format('Msg received from 16-bit: %s',
  117.     [StrPas(Ptr16To32Fix(ReturnedMsg))]));
  118.   Ptr16To32Unfix(ReturnedMsg);
  119. end;
  120.  
  121. procedure TForm1.BtnGenericApproachClick(Sender: TObject);
  122. const
  123.   // These are from Delphi 1's WinTypes unit
  124.   gfsr_SystemResources = $0000;
  125.   gfsr_GDIResources    = $0001;
  126.   gfsr_UserResources   = $0002;
  127. var
  128.   Sys, User, GDI: Word;
  129. begin
  130.   Sys := LoWord(Call16BitRoutine('GetFreeSystemResources',
  131.     User16Handle, ccPascal, [gfsr_SystemResources], [SizeOf(Word)]));
  132.   User := LoWord(Call16BitRoutine('GetFreeSystemResources',
  133.     User16Handle, ccPascal, [gfsr_UserResources], [SizeOf(Word)]));
  134.   GDI := LoWord(Call16BitRoutine('GetFreeSystemResources',
  135.     User16Handle, ccPascal, [gfsr_GDIResources], [SizeOf(Word)]));
  136.   MessageDlg(Format(
  137.     'System = %d%%'#13'User = %d%%'#13'GDI = %d%%',
  138.     [Sys, User, GDI]),
  139.     mtInformation, [mbOk], 0);
  140. end;
  141.  
  142. initialization
  143.   DLLHandle := LoadLib16('DLL16Bit.DLL');
  144. finalization
  145.   FreeLibrary16(DllHandle);
  146. end.
  147.